use strict;
use utf8;
use Data::Dumper;

binmode(STDOUT, ":encoding(utf-8)");
binmode(STDERR, ":encoding(utf-8)");

my %f2cl; # совместная встречаемость признаков и классов
my %cl2c; # кол-во примеров в классах
my %pools;
my %ex2feat; 

foreach my $f (@ARGV) {
  my %p = load_pool($f, 3);
  @pools{keys %p} = values %p;
}

print STDERR "pools loaded ...\n";

generate_statistics(\%pools, 4);

explain_classes(\%pools, \%ex2feat);



#print "total err: " . $total_err . "\n";
#foreach my $x (sort {$f2err{$b}/$fall{$b} <=> $f2err{$a}/$fall{$a}} keys %fall) {
#  if ($f2err{$x} > 4 && ($f2err{$x} / $fall{$x}) >= 0.01 && ($f2err{$x} / $total_err) >= 0.01) {
#    print "$x\t" . $f2err{$x} . " " . $f2err{$x} / $fall{$x} . " " . $f2err{$x} / $total_err . " " . $fall{$x} . "\n";
#  }
#}

sub explain_classes {
  my ($rp, $re2f) = @_;
  my %fInUse;
  my %f2cl;

  while (1) {
    %f2cl = ();
    update_feature_statistics($rp, \%f2cl, $re2f);

    my $feat = get_next_feature(\%f2cl, \%fInUse);
    if (! defined($feat)) {
      print "no more features :(\n";
      return;
    }

    $fInUse{$feat} = 1;

    foreach my $sid (keys %{$rp}) {
      if (exists $re2f->{$sid}) { next; } # already explained example
      #if ("GOOD" eq get_example_class($rp->{$sid})) { next; } # it's all right with this example

      if (exists($rp->{$sid}->{features}->{$feat})) {
        $re2f->{$sid} = $feat;
      }
    }

    my ($a, $b, $c) = count_explained($rp, $re2f);
    print "$a explained, $b unexplained, $c waste\n";
  }
}

sub count_explained {
  my ($rp, $re2f) = @_;
  my ($yes, $no, $waste) = (0, 0, 0);

  foreach my $sid (keys %{$rp}) {
    if ("GOOD" eq get_example_class($rp->{$sid})) {
      if (exists $re2f->{$sid}) {
        $waste++;
      }
      next;
    }

    if (exists $re2f->{$sid}) { $yes++; }
    else { $no++; }
  }

  return ($yes, $no, $waste);
}

sub get_feature_rating {
  my ($f, $rf2cl) = @_;
  my $r = $rf2cl->{$f}->{BAD} / $rf2cl->{$f}->{total};

# print "FR $f $r $rf2cl->{$f}->{BAD} $rf2cl->{$f}->{total} " . ($rf2cl->{$f}->{BAD} * 0.01) . "\n";
  $r = $r + ($rf2cl->{$f}->{BAD} - $rf2cl->{$f}->{GOOD}) * 0.01; # / $rf2cl->{$f}->{total} ;
  
  return $r;
}

sub get_next_feature {
  my ($rf2cl, $rfInUse) = @_;

  foreach my $f (sort {get_feature_rating($b, $rf2cl) <=> get_feature_rating($a, $rf2cl)} keys %{$rf2cl}) {
    if (exists $rfInUse->{$f}) { next; } # feature already in use

    if ($rf2cl->{$f}->{BAD} < 5) { next; } # too unfrequent feature

    my $debug_line = "$f " . Dumper($rf2cl->{$f});
    $debug_line =~ s/\n/ /gsm;
    $debug_line =~ s/\s+/ /g;
    print $debug_line . "\n";
 
    return $f;
  }

  return undef;
}

sub update_feature_statistics {
  my ($rp, $rf2cl, $re2f) = @_;

  foreach my $sid (keys %{$rp}) {
    if (exists $re2f->{$sid}) { next; } # already explained example
    my $rfeat = $rp->{$sid}->{features};

    foreach my $f (keys %{$rfeat}) {
      $rf2cl->{$f}->{total} += 1;
      $rf2cl->{$f}->{get_example_class($rp->{$sid})} += 1;
    }
  }
}


sub generate_statistics {
  my ($rp, $n) = @_;

  foreach my $re (keys %{$rp}) {
    my @feat = generate_features_by_example($rp->{$re}, $n, $n);
    my %fmap = map { $_ => 1 } @feat;
    $rp->{$re}->{features} = \%fmap;

    $cl2c{get_example_class($rp->{$re})} += 1;
  }
}

sub get_example_class {
  my ($re) = @_;

  if (scalar(keys %{$re->{vote}}) > 1) {
    return "BAD";
  } else {
    return "GOOD";
  }
}

sub generate_features_by_example {
  my ($re, $max_before, $max_after) = @_;
  my @f;

  for (my $i = 0; $i < $max_before; $i++) {
    if (0 == length($re->{before}->[$i])) { last; }

    my @feat = generate_features_by_token($re->{before}->[$i]);
    foreach my $x (@feat) { 
      push @f, $x . " @ -" . ($i+1);
    }
  }

  for (my $i = 0; $i < $max_after; $i++) {
    if (0 == length($re->{after}->[$i])) { last; }

    my @feat = generate_features_by_token($re->{after}->[$i]);
    foreach my $x (@feat) {
      push @f, $x . " @ +" . ($i+1);
    }
  }

  my @feat = generate_features_by_token($re->{word});
  foreach my $x (@feat) {
    push @f, $x . " @ 0";
  }  

#  foreach my $x (@f) {
#    print STDERR "$x\n";
#  }

  return @f;
}

sub generate_features_by_token {
  my ($text) = @_;
  my @f;
  my $text_lc = $text;
  $text_lc =~ tr/А-ЯЁA-Z/а-яёa-z/;

  push @f, "word=" . $text_lc;
  push @f, "len=" . length($text);
  if ($text =~ /^[\;\.\!\?]$/) { push @f, "set=[;.!?]"; }
  elsif ($text =~ /^[\,\-\:]$/) { push @f, "set=[,-:]"; }
  if ($text =~ /^([0-9][0-9\,\.]+)?[0-9]+$/) { push @f, "set=[0-9,.]"; }
  if ($text =~ /^[A-ZА-ЯЁ][a-zа-яё\-\.]+$/) { push @f, "cap=Aaaa"; }
  if ($text =~ /^[a-zа-яё\-\.]+$/) { push @f, "cap=aaaa"; }
  if ($text =~ /^[A-ZА-ЯЁ]+[a-zа-яё\-\.]+[A-ZА-ЯЁ]+.*$/) { push @f, "cap=AaAa"; }
  if ($text =~ /^[A-ZА-ЯЁ\-\.]+$/) { push @f, "cap=AAAA"; }

  return @f;
}

sub load_pool {
  my ($fn, $nannotators) = @_;
  my %h;

  open(F, "< $fn") || die "Can't open \"$fn\"";
  binmode(F, ":encoding(utf-8)");
  while (<F>) {
    chomp $_;
    $_ =~ s/\t /\t/g;
    my ($sid, $text, $comment, @answer) = split(/\t/, $_);
    $text =~ tr/А-ЯЁ/а-яё/;
    $h{$sid}->{text} = $text;
    if ($text =~ /^(.*?)\[\[(.*?)\]\]\s*(.*)$/) {
      ($h{$sid}->{textbefore}, $h{$sid}->{word}, $h{$sid}->{textafter}) = ($1, $2, $3);
      @{$h{$sid}->{before}} = (reverse(split(/\s+/, $h{$sid}->{textbefore})), "SENT_START");
      @{$h{$sid}->{after}} = (split(/\s+/, $h{$sid}->{textafter}), "SENT_END");
    } else {
      die "can't parse \"$text\"";
    }
    $h{$sid}->{comment} = $comment;
    for (my $i = 0; $i < $nannotators; $i++) {
      $h{$sid}->{user}->[$i] = $answer[$i];
    }
    $h{$sid}->{good} = $answer[$nannotators+1];
    $h{$sid}->{status} = $answer[$nannotators+2];

    foreach my $v (@{$h{$sid}->{user}}) {
      $h{$sid}->{vote}->{$v} += 1;
    }

#    for (my $i = 0; $i < $#{$h{$sid}->{before}}; $i += 1) {
#      if ($h{$sid}->{before}->[$i] =~ /^\d*[234]$/) {
#        $h{$sid}->{before}->[$i] = "FEATURE\\d*[234]";
#      } elsif ($h{$sid}->{before}->[$i] =~ /^\d+$/) {
#        $h{$sid}->{before}->[$i] = "FEATURE\\d+";
#      } elsif ($h{$sid}->{before}->[$i] =~ /^(дв[ае]|об[ае]|три|четыре)$/) {
#        $h{$sid}->{before}->[$i] = "FEATUREДВАОБАТРИЧЕТЫРЕ";
#      } elsif ($h{$sid}->{before}->[$i] =~ /^(млрд|миллионов|тыс|тысяч)$/) {
#        $h{$sid}->{before}->[$i] = "FEATUREМЛРДМИЛЛТЫС";
#      } 
#    }

#    print Dumper(\%h);
#    die;
  }
  close(F);
  return %h;
}
